home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
tbbs
/
prgsourc.zip
/
HOMES.ZIP
/
PSUB.PRG
< prev
next >
Wrap
Text File
|
1996-01-08
|
6KB
|
228 lines
PROCEDURE psub
PARAMETERS md
SELECT e
PRIVATE x
PRIVATE y
PRIVATE z
PRIVATE page
PRIVATE cnt
COUNT TO cnt
GOTO TOP
IF cnt > 15
page = 15
x = cnt/15
z = Int(x) + 1
DECLARE asub[z]
x = 1
asub[x] = sname
x = 2
DO WHILE x <= z
SKIP 15
asub[x] = sname
x = x + 1
ENDDO
ELSE
page = cnt
ENDIF
SET COLOR TO GR+/R
@ 21,0 CLEAR TO 23,79
@ 21,5 SAY "Up/Dn Arrow "
IF cnt > 15
@ 21,55 SAY "<Page Up>"
@ 22,55 SAY "<Page Dn>"
ENDIF
@ 23,5 SAY "S"
@ 22,5 SAY "<Enter> "
IF md > 2
@ 23,55 SAY "N"
ENDIF
SET COLOR TO W+/R
@ 21,17 SAY "= Move within pick list"
IF cnt > 15
@ 21,65 SAY "= Page Up"
@ 22,65 SAY "= Page Down"
ENDIF
@ 23,7 SAY "= Not in Subdivision"
@ 22,13 SAY "= Select from pick list"
IF md > 2
@ 23,57 SAY "= No Preference"
ENDIF
SET COLOR TO BG/BG
@ 3,50 CLEAR TO page+4,74
SET COLOR TO N/BG
@ 3,50 TO page+4,74
GOTO TOP
y = 1
x = 1
DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
SKIP
x = x + 1
@ x+3,51 SAY sname
ENDDO
SET COLOR TO GR+/BG
SEEK asub[y]
@ 4,51 SAY sname
x = 1
SET FORMAT TO fscr NOCLEAR
SET COLOR TO N/N
@ 2,0 GET charin
DO WHILE .T.
READ
DO CASE
CASE LastKey() = 3 && <Page Down>
IF y = z
LOOP
ENDIF
SET COLOR TO N/BG
y = y + 1
IF y = z
@ 4,51 CLEAR TO page+3,73
ENDIF
SEEK asub[y]
x = 1
DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
SKIP
x = x + 1
@ x+3,51 SAY sname
ENDDO
SET COLOR TO GR+/BG
SEEK asub[y]
@ 4,51 SAY sname
x = 1
LOOP
CASE LastKey() = 5 && <Up Arrow>
IF x = 1 .AND. y = 1
LOOP
ENDIF
SET COLOR TO N/BG
IF x = 1
y = y - 1
SEEK asub[y]
@ 4,51 SAY sname
x = 1
DO WHILE x < 15
SKIP
x = x + 1
@ x+3,51 SAY sname
ENDDO
SET COLOR TO GR+/BG
@ x+3,51 SAY sname
ELSE
@ x+3,51 SAY sname
x = x - 1
SKIP -1
SET COLOR TO GR+/BG
@ x+3,51 SAY sname
ENDIF
LOOP
CASE LastKey() = 13 && <Enter>
DO CASE
CASE md = 1 && Called by enew(list)
cksub = sname
CASE md = 2 && Called by enew(add)
SELECT a
REPLACE sub WITH e->sname
CASE md = 3 .OR. md = 4 && Called by search
SELECT d
REPLACE sub WITH e->sname
ENDCASE
EXIT
CASE LastKey() = 18 && <Page Up>
IF y = 1
LOOP
ENDIF
SET COLOR TO N/BG
y = y - 1
SEEK asub[y]
x = 1
DO WHILE x < 15
SKIP
x = x + 1
@ x+3,51 SAY sname
ENDDO
SET COLOR TO GR+/BG
SEEK asub[y]
@ 4,51 SAY sname
x = 1
LOOP
CASE LastKey() = 24 && <Dn Arrow>
IF x + (15 * (y - 1)) = cnt
LOOP
ENDIF
SET COLOR TO N/BG
IF x = 15
IF y = z
LOOP
ENDIF
y = y + 1
IF y = z
@ 4,51 CLEAR TO page+3,73
ENDIF
SEEK asub[y]
x = 1
DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
SKIP
x = x + 1
@ x+3,51 SAY sname
ENDDO
SET COLOR TO GR+/BG
SEEK asub[y]
@ 4,51 SAY sname
x = 1
ELSE
@ x+3,51 SAY sname
x = x + 1
SKIP
SET COLOR TO GR+/BG
@ x+3,51 SAY sname
ENDIF
LOOP
CASE LastKey() = 27 && <Esc>
IF md = 3 .OR. md = 4
SELECT d
ENDIF
EXIT
CASE LastKey() = 78 .OR. LastKey() = 110 && No Preference
IF md < 3
LOOP
ENDIF
SELECT d
REPLACE sub WITH "..No Preference "
EXIT
CASE LastKey() = 83 .OR. LastKey() = 115 && Not in Subdivision
DO CASE
CASE md = 1 && Called by enew(list)
LOOP
CASE md = 2 && Called by enew(add)
SELECT a
REPLACE sub WITH "..Not in Subdivision "
CASE md = 3 .OR. md = 4 && Called by search
SELECT d
REPLACE sub WITH "..Not in Subdivision "
ENDCASE
EXIT
ENDCASE
ENDDO
RELEASE asub
DO cls WITH 2,50,19,74
RETURN